home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_200 / 297_02 / sprolog.ini < prev    next >
Text File  |  1991-12-23  |  5KB  |  226 lines
  1. /* sprolog.ini */
  2. /* This file gets loaded when Small Prolog starts up */
  3.  
  4. /* negation by failure */
  5. ((not X)
  6.  X (cut) (fail))
  7. ((not X))
  8.  
  9. /* membership in a list */
  10. ((member X (X|Y))
  11. )
  12. ((member X (A|B))
  13.  (member X B)
  14. )
  15.  
  16. /* unify both arguments */
  17. ((eq X X))
  18.  
  19. /* test if not unifiable */
  20. ((diff X X)(cut)(fail)
  21. )
  22. ((diff X Y))
  23.  
  24. /* append two lists */
  25. ((append (A|X) Y (A|Z))
  26.  (append X Y Z)
  27. )
  28. ((append () X X))
  29.  
  30. /* naive reverse -a classic inefficient algorithm */
  31.  
  32. ((nrev (X|Y) U)
  33.  (nrev Y L)(append L (X) U)
  34. )
  35. ((nrev ()()))
  36.  
  37. /* a benchmark - clock may not work on all systems */
  38. ((bench)
  39.  (clock T1)
  40.  (n_unifications Nu1)
  41.  (nrev (1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0)L)
  42.  (clock T2)
  43.  (n_unifications Nu2)
  44.  (iminus T2 T1 Tdiff)
  45.  (iminus Nu2 Nu1 Nudiff)
  46.  (display L)(nl)
  47.  (display Nudiff)(writes " unifications in ")
  48.  (display Tdiff)(writes " microseconds.")(nl)
  49. )
  50.  
  51. /* List is the list of all facts corresponding to Predicate */
  52. ((all_facts (Predicate|Args) List)
  53.  (first_clause Predicate Clause)
  54.  (cut)
  55.  (allfacts1 Clause Args List)
  56. )
  57. ((all_facts X ()))
  58.  
  59. ((allfacts1 Clause Args ((Pred|ArgsHead)|L))
  60.  (body_clause Clause ((Pred|ArgsHead)))
  61.  (unifies ArgsHead Args)
  62.  (cut)
  63.  (allfacts2  Clause Args L)
  64. )
  65.  
  66. ((allfacts2 Clause Args L)
  67.  (next_clause Clause Clause2)
  68.  (cut)
  69.  (allfacts1 Clause2 Args L)
  70. )
  71. ((allfacts2 Clause Args ()))
  72.  
  73. /* Nondeterministic : unifies arguments to all possible
  74.  * Clause-head and clause tails respectively 
  75. */
  76. ((clause (Predicate|Args) Goals)
  77.  (atom Predicate)/* Predicate known */
  78.  (cut)
  79.  (choose_clause Predicate Clause)/* Clause backtracks though Clauses */
  80.  (body_clause Clause ((Predicate|Args)|Goals))/* this is a builtin */
  81. )
  82.  
  83. ((clause (Predicate|Args) Goals)
  84.  (predicate Predicate)
  85.  (choose_clause Predicate Clause)
  86.  (body_clause Clause ((Predicate|Args)|Goals))
  87. )
  88.  
  89.  
  90. ((predicate P) /* predicate enumerates all predicates P */
  91.  (first_predicate Pred1) /* builtin */
  92.  (predicates_after Pred1 P )
  93. )
  94.  
  95. ((predicates_after P P))
  96. ((predicates_after Pred P)
  97.  (next_predicate Pred Next)/* builtin */
  98.  (predicates_after Next P)
  99. )
  100.  
  101. ((choose_clause Predicate Clause)
  102.  (first_clause Predicate Clause1)
  103.  (clause_after Clause1 Clause)
  104. )
  105. (clause_after Clause1 Clause1)
  106. ((clause_after Clause1 Clause)/* builtin */
  107.  (next_clause Clause1 Clause2)
  108.  (clause_after Clause2 Clause)
  109. )
  110.  
  111. /* test if terms are unifiable but throws away bindings */
  112. ((unifies X Y)(diff X Y)(cut)(fail))
  113. ((unifies X Y))
  114.  
  115.  
  116. ((retract (Head | Tail))/* handles unit clauses only for the time */
  117.  (atom Head)
  118.  (retract1 Head Tail)
  119. )
  120.  
  121. ((retract1 Predicate Tail)
  122.  (find_clause Predicate Clause)
  123.  (body_clause Clause ((Predicate | Tail)) )
  124.  (remove_clause Clause)
  125. )
  126.  
  127. ((find_clause Predicate Clause)
  128.  (first_clause Predicate Clause1)
  129.  (find_clause1 Clause1 Clause)
  130. )
  131.  
  132. (find_clause1 Clause_a Clause_a)
  133. ((find_clause1 Clause_a Clause)
  134.  (next_clause Clause_a Clause_b)
  135.  (find_clause1 Clause_b Clause)
  136. )
  137.  
  138.  
  139. /* no fixed arity version of conjunction  */
  140. ((and))
  141. ((and X | Y)
  142.  X
  143.  (and Y)
  144. )
  145. /* binary version */
  146. ((binary_or X _) X)
  147. ((binary_or _ Y) Y)
  148.  
  149. /* general version */
  150. ((or X|_) X)
  151. ((or _|Y)(or | Y))
  152.  
  153. /* see Clocsin & Mellish 
  154.    25/12/91 this is now a builtin
  155. ((repeat))
  156. ((repeat)(repeat))
  157. */
  158. /* find out how much room is left */
  159. ((statistics)
  160.  (space_left Heap Str Dyn Subst Trail Temp)
  161.  (there_remains Heap "heap")
  162.  (there_remains Str "strings")
  163.  (there_remains Dyn "contol stack")
  164.  (there_remains Subst "substitutions")
  165.  (there_remains Trail "trail")
  166.  (there_remains Temp "temp")
  167. )
  168.  
  169. ((there_remains Bytes Zone)
  170.  (writes "There remains ")
  171.  (display Bytes)
  172.  (writes " bytes for the ")
  173.  (writes Zone)
  174.  (writes ".")
  175.  (nl)
  176. )
  177.  
  178. /* calculate the nth element of list */
  179. (list_nth 0 (X|_) X)
  180. ((list_nth N (_|Y) X)
  181.  (iminus N 1 N-1)
  182.  (list_nth N-1 Y X)
  183. )
  184.  
  185. /* sum a list of integers 
  186.  * The result is the first argument 
  187.  */
  188. ((sum 0 )(cut))
  189. ((sum S X|Y)
  190.  (sum S1| Y)
  191.  (iplus S1 X S)
  192. )
  193.  
  194. /* This is from Clocksin and Mellish 
  195.  * It is not very fast.
  196.  * We use temp_asserta so that the memory can be cleaned with
  197.  * clean_temp 
  198.  */
  199. ((findall X G _)
  200. /* (suspend_trace) */
  201.  (temp_asserta (found mark))
  202.  G
  203.  (temp_asserta (found X))
  204.  (fail)
  205. )
  206. ((findall _ _ L)
  207.  (collect_found () M)
  208.  (cut)
  209.  (eq L M)
  210. /* (resume_trace) */
  211. )
  212.  
  213. ((collect_found S L)
  214.  (getnext X)
  215.  (cut)
  216.  (collect_found (X|S) L)
  217. )
  218. (collect_found L L)
  219.  
  220. ((getnext X)
  221.  (retract (found X)) 
  222.  (cut)
  223.  (diff X mark)
  224. )
  225.  
  226.